home *** CD-ROM | disk | FTP | other *** search
Wrap
#!/usr/bin/perl print "Content-type: text/html\n\n"; # the first line MUST point to the location of perl on your server if # you are running this program on a unix server. # you may try also "#!/usr/local/bin/perl". ####################################################################### # free CGI scripts by Homemade Scripts / copyright. # free download at http://www.automarktregistrierung.de/webmaster.html. # author may not be held responsible # for any damage caused by use of this script. # you may change this script for your needs. # if you need help for setup or like to customize this script, # or if you found a bug, or any comments, # drop mail to "deschakovskiholger@freenet.de". # ####################################################################### # set up to be done by user. # # create a folder named maybe "diary2002" inside your cgi-bin. # upload "diary2002.cgi" in your "diary2002" folder. # chmod "diary2002.cgi" 755. $homepath = "/usr/local/httpd/htdocs/www/yoursite.com/cgi-bin/diary2002"; # absolute homepath to your "diary2002" folder according to your site. # leave the backslash "/" at the end of homepath. # following variables maybe changed if you like to!!! $textdir = "articles"; # name of folder where articles are stored. # this folder will be created by diary2002 inside your "diary2002" folder. # you may rename this folder according to your needs. $userdir = "user"; # name of folder where user info is stored. # this folder will be created by diary2002 inside your "diary2002" folder. # you may rename this folder according to your needs. # last step: # call diary2002.cgi with your browser like this: # http://www.yoursite.com/cgi-bin/diary2002/diary2002.cgi # follow instructions displayed on screen. # there should be no more work to do for you. # you will be able to change the layout and user info, # like password and user name plus many more inside your admin area. ####################################################################### # initiate cgi modul. use CGI; my $cgi = new CGI; use CGI::Carp qw(fatalsToBrowser); # relative script path. $rel = $cgi->url(-relative=>1); ####################################################################### # absolute pathes for directorys. $textdirectory = "$homepath/$textdir"; $userdirectory = "$homepath/$userdir"; ####################################################################### # control if file text exists. $showcontrol = -e "$userdirectory/file.txt"; # if $showcontrol doesnt exist, initiate first time run. # first time run code following now. if ("$showcontrol" ne "1") { # create directorys. mkdir($textdir, 0777); # textdirectory where articles are stored. mkdir($userdir, 0777); # userdirectory where user info is stored. # print your user info file first time. open (PRO,">$userdirectory/file.txt"); print PRO "admin\n"; print PRO "pwd"; close(PRO); # print your layout info file first time. open (ENV,">$userdirectory/layout.txt"); print ENV "my online journal\n"; print ENV "#FFFFFF\n"; print ENV "#000000\n"; print ENV "4\n"; close (ENV); # print welcome and instructions for first time use. print "<h2>welcome to diary2002 - my online journal</h2>"; print "please follow instructions for first time run.<p>"; print "use following: username = admin, password = pwd for first time \"user login\"<br>"; print "login immediately and change your username and password.<br>"; print "inside your admin area you may also change the layout for diary2002<p>"; print "(this info will show up only one time)<p><br>";} ####################################################################### ####################################################################### ####################################################################### # definition for parameters coming in from html forms. # for sub "open" & "process". $user1 = $cgi->param('user'); $pass1 = $cgi->param('pass'); # for sub "post". $title = $cgi->param('title'); $article = $cgi->param('article'); # for sub "delete". $file = $cgi->param('file'); # for sub "prolayout". $slogan1 = $cgi->param('slogan'); $back1 = $cgi->param('back'); $font1 = $cgi->param('font'); $number1 = $cgi->param('number'); # for sub "searchme". $search = $cgi->param('search'); ###################################################################### # start the show! # get layout variables. &layout; # get time and date. print html. &timer; $dat = "current date and time $date | $time"; print "<html>\n"; print "<head>\n"; print "$head\n"; print "</head>\n"; print "<body bgcolor=\"$backcolor\"><center>\n"; print "<table border=0 width=700><tbody><tr valign=top>\n"; print "<td align=left>"; print "<table border=0>"; print "<tr><td> </td><td> </td><td>$brick</td><td> </td><td>$brick</td><td> </td><td> </td><td> </td><td> </td><td> </td><td> </td><td> </td><td> </td><td> </td><td>$brick</td><td> </td><td> </td><td> </td><td>$brick</td><td> </td></tr>"; print "<tr><td> </td><td> </td><td>$brick</td><td> </td><td> </td><td> </td><td> </td><td> </td><td>$brick</td><td> </td><td>$brick</td><td>$brick</td><td>$brick</td><td> </td><td> </td><td>$brick</td><td> </td><td>$brick</td><td> </td><td><font color=\"$fontcolor\"><b>2</b></font></td></tr>"; print "<tr><td>$brick</td><td>$brick</td><td>$brick</td><td> </td><td>$brick</td><td> </td><td>$brick</td><td>$brick</td><td>$brick</td><td> </td><td>$brick</td><td> </td><td> </td><td> </td><td> </td><td> </td><td>$brick</td><td> </td><td> </td><td><font color=\"$fontcolor\"><b>0</b></font></td></tr>"; print "<tr><td>$brick</td><td> </td><td>$brick</td><td> </td><td>$brick</td><td> </td><td>$brick</td><td> </td><td>$brick</td><td> </td><td>$brick</td><td> </td><td> </td><td> </td><td> </td><td>$brick</td><td> </td><td> </td><td> </td><td><font color=\"$fontcolor\"><b>0</b></font></td></tr>"; print "<tr><td>$brick</td><td>$brick</td><td>$brick</td><td> </td><td>$brick</td><td> </td><td>$brick</td><td>$brick</td><td>$brick</td><td> </td><td>$brick</td><td> </td><td> </td><td> </td><td>$brick</td><td> </td><td> </td><td> </td><td> </td><td><font color=\"$fontcolor\"><b>2</b></font></td></tr>"; print "</table>"; print "</td>\n"; print "<td align=left><font color=\"$fontcolor\" size=\"+3\">$slogan</font>\n"; print "<br><font color=\"$fontcolor\">$dat</font>\n"; print "<table border=0 cellspacing=10><tbody><tr>\n"; print "<td><a href='$rel?display'>index | read articles</a></td>"; print "<td><a href='$rel?search'>search articles</a></td>\n"; print "<td><a href='$rel?pwd'>user login</a></td>\n"; print "</tr></tbody></table>\n"; print "</td></tr></tbody></table>\n"; print "<table border=0 width=700 cellspacing=50><tbody><tr valign=top><td>"; if($ENV{'QUERY_STRING'} eq 'newpost'){&newpost;} elsif($ENV{'QUERY_STRING'} eq 'delpost'){&delpost;} elsif($ENV{'QUERY_STRING'} eq 'admin'){&admin;} elsif($ENV{'QUERY_STRING'} eq 'display'){&display;} elsif($ENV{'QUERY_STRING'} eq 'post') {&post;} elsif($ENV{'QUERY_STRING'} eq 'delete') {&delete;} elsif($ENV{'QUERY_STRING'} eq 'delall') {&delall;} elsif($ENV{'QUERY_STRING'} eq 'displong') {&displong;} elsif($ENV{'QUERY_STRING'} eq 'dispback') {&dispback;} elsif($ENV{'QUERY_STRING'} eq 'process') {&process;} elsif($ENV{'QUERY_STRING'} eq 'pwd') {&pwd;} elsif($ENV{'QUERY_STRING'} eq 'open') {&open;} elsif($ENV{'QUERY_STRING'} eq 'prolayout') {&prolayout;} elsif($ENV{'QUERY_STRING'} eq 'search') {&search;} elsif($ENV{'QUERY_STRING'} eq 'searchme') {&searchme;} else {&display;} print "</td></tr></tbody></table>"; print "<a href='http://www.automarktregistrierung.de/webmaster.html'>⌐ diary2002.cgi | my online journal</a>"; print "</center></body></html>\n"; ###################################################################### # post new article. sub newpost { print "<h2><font color=\"$fontcolor\">post new article.</font></h2>"; print "<form action=\"$rel?post\" method=\"post\">"; print "<table border=0 cellPadding=3><tbody>"; print "<tr><td><font color=\"$fontcolor\">title</font> "; print "<INPUT type=text name=title size=55></td></tr>"; print "<tr><td><textarea name=article cols=50 rows=10></textarea>"; print "</td></tr></tbody></table>"; print "<INPUT name=submit type=submit value=submit> <INPUT name=reset type=reset value=reset></form>"; print "<font color=\"$fontcolor\">INFO: if you like to post a link to an website.<br>please use following html syntax:<br><a href=\"http://www.sitename.com\">sitename</a><br>or following for posting an email adress:<br><a href=\"mailto:webmaster\@yoursite.com\">webmaster\@yoursite.com</a></font>"; print "<p><table border=0 cellspacing=10><tbody><tr>\n"; print "<td><a href='$rel?delpost'>delete article</a></td>\n"; print "<td><a href='$rel?admin'>admin area</a></td>\n"; print "</tr></tbody></table>\n";} ###################################################################### # display articles. sub display { chdir ("$textdirectory"); @text = glob "*.txt"; @sort = sort {$b <=> $a} @text; print "<h2><font color=\"$fontcolor\">read articles.</font></h2>"; if (@sort == "0"){ print "<font color=\"$fontcolor\">soorry. no articles to read.</font>";} else { open (DIS,"$userdirectory/count.txt"); $readcount = <DIS>; $countdisplay = "number of articles online: $readcount"; print "<font color=\"$fontcolor\">$countdisplay</font>"; close(DIS); if (@sort <= $artnr) { foreach $text (@sort){ open (TEXT,"$textdirectory/$text"); @tex = <TEXT>; $line = shift(@tex); $popdate = pop(@tex); print "<table border=1 cellpadding=5 width=600><tbody>"; print "<tr><td align=left><font color=\"$fontcolor\"><b>$line</b></font></td></tr>"; print "<tr><td align=left><font color=\"$fontcolor\">"; foreach $textline (@tex) { print "$textline<br>";} print "</font><p>"; print "<font color=\"$fontcolor\" size=\"-1\">$popdate</font></td></tr>"; print "</tbody></table><p>"; close (TEXT);}} else { print " <font color=\"$fontcolor\">|</font> <a href='$rel?displong'>next articles</a>"; foreach (1..$artnr) { $shifttext = shift(@sort); open (TEXT,"$textdirectory/$shifttext"); @tex = <TEXT>; $line = shift(@tex); $popdate = pop(@tex); print "<table border=1 cellpadding=5 width=600><tbody>"; print "<tr><td align=left><font color=\"$fontcolor\"><b>$line</b></font></td></tr>"; print "<tr><td align=left><font color=\"$fontcolor\">"; foreach $textline (@tex) { print "$textline<br>";} print "</font><p>"; print "<font color=\"$fontcolor\" size=\"-1\">$popdate</font></td></tr>"; print "</tbody></table><p>"; close (TEXT);} print "<a href='$rel?displong'>next articles</a>"; open (SORT,">$userdirectory/sort.txt"); foreach $print (@sort){ print SORT "$print\n";} close (SORT);} }} ###################################################################### # display articles bigger than $artnr for one site. sub displong { open (SORTA,"$userdirectory/sort.txt"); @sort1 = <SORTA>; close (SORTA); open (DIS,"$userdirectory/count.txt"); $readcount = <DIS>; $countdisplay = "number of articles online: $readcount"; close(DIS); print "<h2><font color=\"$fontcolor\">read articles.</font></h2>"; print "<font color=\"$fontcolor\">$countdisplay</font>"; if (@sort1 <= $artnr) { print " <font color=\"$fontcolor\">|</font> <a href='$rel?displong'>previous articles</a>"; foreach $text1 (@sort1) { open (TEXT,"$textdirectory/$text1"); @tex = <TEXT>; $line = shift(@tex); $popdate = pop(@tex); print "<table border=1 cellpadding=5 width=600><tbody>"; print "<tr><td align=left><font color=\"$fontcolor\"><b>$line</b></font></td></tr>"; print "<tr><td align=left><font color=\"$fontcolor\">"; foreach $textline (@tex) { print "$textline<br>";} print "</font><p>"; print "<font color=\"$fontcolor\" size=\"-1\">$popdate</font></td></tr>"; print "</tbody></table><p>"; close (TEXT);} print "<a href='$rel?displong'>previous articles</a>"; open (SORTB,">$userdirectory/sort.txt"); $back1 = "@sort1"; $back = substr ($back1, 0, 1); $backcount = $back + $artnr; foreach (1..$artnr) { $new = $backcount--; print SORTB "$new.txt\n";} foreach $back2 (@sort1) { print SORTB "$back2";} close (SORTB); } else { @sort2 = @sort1; $highcontrol = shift(@sort2); substr($highcontrol, -5) = ""; if ($highcontrol == $readcount) { print " <font color=\"$fontcolor\">|</font> <a href='$rel?displong'>next articles</a>";} else { print " <font color=\"$fontcolor\">|</font> <a href='$rel?displong'>next articles</a>"; print " <font color=\"$fontcolor\">|</font> <a href='$rel?dispback'>previous articles</a>";} foreach (1..$artnr) { $shifttext1 = shift(@sort1); open (TEXT,"$textdirectory/$shifttext1"); @tex = <TEXT>; $line = shift(@tex); $popdate = pop(@tex); print "<table border=1 cellpadding=5 width=600><tbody>"; print "<tr><td align=left><font color=\"$fontcolor\"><b>$line</b></font></td></tr>"; print "<tr><td align=left><font color=\"$fontcolor\">"; foreach $textline (@tex) { print "$textline<br>";} print "</font><p>"; print "<font color=\"$fontcolor\" size=\"-1\">$popdate</font></td></tr>"; print "</tbody></table><p>"; close (TEXT);} if ($highcontrol == $readcount) { print "<a href='$rel?displong'>next articles</a>";} else { print "<a href='$rel?displong'>next articles</a>"; print " <font color=\"$fontcolor\">|</font> <a href='$rel?dispback'>previous articles</a>";} open (SORT,">$userdirectory/sort.txt"); foreach $print1 (@sort1) { print SORT "$print1";} close (SORT);} } ###################################################################### # articles backcount. sub dispback { open (SORTA,"$userdirectory/sort.txt"); @back = <SORTA>; $back1 = "@back"; close (SORTA); $double = ($artnr*2); $back = substr ($back1, 0, 1); $backcount = $back + $double; open (SORTB,">$userdirectory/sort.txt"); foreach (1..$double) { $new = $backcount--; print SORTB "$new.txt\n";} foreach $back2 (@back){ print SORTB "$back2";} close (SORTB); &displong;} ###################################################################### # process new post. sub post { if (("$title" eq "") || ("$article" eq "")) {print "<font color=\"$fontcolor\">alert no data input. please return <a href='$rel?newpost'>click here</a>.</font>";} else { &timer; &counter; &pluscounter; $countin = "article number: $newcount"; $posted = "posted $date | $time"; open (NEW,">$textdirectory/$newcount.txt"); print NEW "$title\n"; print NEW "$article\n"; print NEW "$posted | $countin\n"; close (NEW); print "<h2><font color=\"$fontcolor\">new article $title posted.</font></h2>"; print "<a href='$rel?display'>click here to read</a>"; &close;} print "<p><table border=0 cellspacing=10><tbody><tr>\n"; print "<td><a href='$rel?newpost'>new article</a></td>\n"; print "<td><a href='$rel?delpost'>delete article</a></td>\n"; print "<td><a href='$rel?admin'>admin area</a></td>\n"; print "</tr></tbody></table>\n";} ###################################################################### # get time and date. sub timer { use POSIX qw(strftime); $date = strftime "%Y-%m-%d", localtime; $time = strftime "%H:%M:%S", localtime;} ###################################################################### # counter for articles. sub counter { open (COUNT,"$userdirectory/count.txt"); $oldcount = <COUNT>; close (COUNT); open (COUNTER,">$userdirectory/count.txt");} sub minuscounter { $minuscount = $oldcount - 1; print COUNTER "$minuscount";} sub pluscounter { $newcount = $oldcount + 1; print COUNTER "$newcount";} sub close { close (COUNTER);} ###################################################################### # delete article form. sub delpost { chdir ("$textdirectory"); @deleteun = glob "*.txt"; @delete = sort {$a <=> $b} @deleteun; print "<h2><font color=\"$fontcolor\">delete article.</font></h2>"; if (@delete == "0") { print "<font color=\"$fontcolor\">no articles to delete. please post one.</font> "; print "<a href='$rel?newpost'>click here</a>";} else { print "<font color=\"$fontcolor\">delete all articles</font> <a href='$rel?delall'>click here</a>.<br>"; print "<font color=\"$fontcolor\">or choose only one article to be deleted.</font>"; print "<form action=\"$rel?delete\" method=\"post\">"; print "<table border=0 cellPadding=3><tbody>"; foreach $del (@delete) { open (DEL,"$del"); @tit = <DEL>; $tit = shift(@tit); print "<tr><td><INPUT type=radio name=file value=$del><font color=\"$fontcolor\">$del | $tit.</font></td></tr>"; close (DEL);} print "</tbody></table>"; print "<INPUT name=submit type=submit value=delete> <INPUT name=reset type=reset value=reset></form>"; print "<p><table border=0 cellspacing=10><tbody><tr>\n"; print "<td><a href='$rel?newpost'>new article</a></td>\n"; print "<td><a href='$rel?admin'>admin area</a></td>\n"; print "</tr></tbody></table>\n";}} ###################################################################### # process delete articles. sub delete { if ("$file" eq "") {print "<font color=\"$fontcolor\">alert no data input. please return <a href='$rel?delpost'>click here</a>.</font>";} else { &counter; &minuscounter; open(TITO,"$textdirectory/$file"); @tito = <TITO>; $tito = shift(@tito); print "<h2><font color=\"$fontcolor\">article deleted.</font></h2>"; print "<font color=\"$fontcolor\">$file | $tito deleted.</font><p>"; close (TITO); unlink "$textdirectory/$file"; &close; chdir "$textdirectory"; @rebuildun = glob "*.txt"; @rebuild = sort {$a <=> $b} @rebuildun; if (@rebuild == "0"){} else { substr ($file, -4) = ""; do { $rebuild = shift(@rebuild); substr ($rebuild, -4) = ""; if ("$rebuild" < "$file") {} else { $log = "$rebuild"; open (BUILDER,"$textdirectory/$log.txt"); @build = <BUILDER>; $build = pop (@build); do { chop ($build); $zero = length($build);} until ($zero == "46"); close(BUILDER); open (BU,">$textdirectory/$log.txt"); $newlog = $log - 1; $buildtit = shift(@build); print BU "$buildtit"; print BU "@build"; print BU "$build $newlog"; close(BU); rename ("$log.txt" , "$newlog.txt"); print "<font color=\"$fontcolor\">$log.txt renamed to $newlog.txt.</font><br>";} }until (@rebuild == 0); if ($rebuild != "1"){ print "<font color=\"$fontcolor\">renamed all file names for counting. all data is save.</font>";}}} print "<p><table border=0 cellspacing=10><tbody><tr>\n"; print "<td><a href='$rel?newpost'>new article</a></td>\n"; print "<td><a href='$rel?delpost'>delete article</a></td>\n"; print "<td><a href='$rel?admin'>admin area</a></td>\n"; print "</tr></tbody></table>\n";} ###################################################################### # delete all articles. sub delall { chdir ("$textdirectory"); @delallun = glob "*.txt"; @delall = sort {$a <=> $b} @delallun; unlink "$userdirectory/count.txt"; unlink "$userdirectory/sort.txt"; foreach $delall (@delall){unlink "$textdirectory/$delall"; print "<font color=\"$fontcolor\">$delall deleted.<br></font>";} print "<h2><font color=\"$fontcolor\">all articles deleted.</font></h2>"; print "<p><table border=0 cellspacing=10><tbody><tr>\n"; print "<td><a href='$rel?newpost'>new article</a></td>\n"; print "<td><a href='$rel?delpost'>delete article</a></td>\n"; print "<td><a href='$rel?admin'>admin area</a></td>\n"; print "</tr></tbody></table>\n";} ###################################################################### # admin area. sub admin { print "<h2><font color=\"$fontcolor\">admin area.</font></h2>"; print "<font color=\"$fontcolor\"><b>1. set username and password.</b></font><br>"; print "<font color=\"$fontcolor\">please use no spaces.</font>"; print "<form action=\"$rel?process\" method=\"post\">"; print "<table border=0 cellPadding=3><tbody>"; print "<tr><td><font color=\"$fontcolor\">username</font></td>"; print "<td><INPUT type=text name=user size=30></td></tr>"; print "<tr><td><font color=\"$fontcolor\">password</font></td>"; print "<td><INPUT type=text name=pass size=30></td></tr>"; print "</tbody></table>"; print "<INPUT name=submit type=submit value=submit> <INPUT name=reset type=reset value=reset></form>"; print "<font color=\"$fontcolor\"><p><b>2. set layout variables.</b><br></font>"; print "<font color=\"$fontcolor\">if you like to change the layout please fill in all five form fields, even if you need to change only one variable!<br></font>"; print "<form action=\"$rel?prolayout\" method=\"post\">"; print "<table border=0 cellPadding=3><tbody>"; print "<tr><td valign=top><font color=\"$fontcolor\">slogan for your journal</font></td>"; print "<td><INPUT type=text name=slogan size=40>"; print "<br><font color=\"$fontcolor\">e.g. my personal diary.</font></td></tr>"; print "<tr><td valign=top><font color=\"$fontcolor\">background color</font></td>"; print "<td><INPUT type=text name=back size=40>"; print "<br><font color=\"$fontcolor\">e.g. #FFFFFF, which is white.</font></td></tr>"; print "<tr><td valign=top><font color=\"$fontcolor\">font color</font></td>"; print "<td><INPUT type=text name=font size=40>"; print "<br><font color=\"$fontcolor\">e.g. #000000, which is black.</font></td></tr>"; print "<tr><td valign=top><font color=\"$fontcolor\">number of articles<br>displayed on one site</font></td>"; print "<td><INPUT type=text name=number size=10>"; print "<br><font color=\"$fontcolor\">e.g. 4, only the number nothing else.</font></td></tr>"; print "</tbody></table>"; print "<INPUT name=submit type=submit value=submit> <INPUT name=reset type=reset value=reset></form>"; print "<p><table border=0 cellspacing=10><tbody><tr>\n"; print "<td><a href='$rel?newpost'>new article</a></td>\n"; print "<td><a href='$rel?delpost'>delete article</a></td>\n"; print "</tr></tbody></table>\n"; print "<table border=1 cellspacing=0 cellpadding=5><tbody>"; print "<tr><td><font color=\"$fontcolor\"><b>some hexadezimal color codes:</b></font></td></tr>"; print "<tr><td>"; print "<table border=0 cellspacing=10><tbody>"; print "<tr><td>#FF0000</td><td><font color='#FF0000'>= red</font></td>"; print "<td>#0000FF</td><td><font color='#0000FF'>= blue</font></td>"; print "<td>#008000</td><td><font color='#008000'>= green</font></td></tr>"; print "<tr><td>#FFFF00</td><td><font color='#FF0000'>= yellow</font></td>"; print "<td>#FF6347</td><td><font color='#FF6347'>= tomato</font></td>"; print "<td>#EE82EE</td><td><font color='#EE82EE'>= violet</font></td></tr>"; print "<tr><td>#C0C0C0</td><td><font color='#C0C0C0'>= silver</font></td>"; print "<td>#A52A2A</td><td><font color='#A52A2A'>= brown</font></td>"; print "<td>#008000</td><td><font color='#008000'>= grey</font></td></tr>"; print "<tr><td>#00BFFF</td><td><font color='#00BFFF'>= deepskyblue</font></td>"; print "<td>#FF69B4</td><td><font color='#FF69B4'>= hotpink</font></td>"; print "<td>#FFE4B5</td><td><font color='#FFE4B5'>= moccasin</font></td></tr>"; print "<tr><td>#800080</td><td><font color='#800080'>= purple</font></td>"; print "<td>#000080</td><td><font color='#000080'>= navy</font></td>"; print "<td>#FFA500</td><td><font color='#FFA500'>= orange</font></td></tr>"; print "</tbody></table>"; print "</td></tr></tbody></table>"; } ###################################################################### # process user info / password / username. sub process { if (("$user1" eq "") || ("$pass1" eq "")) {print "<font color=\"$fontcolor\">alert no data input. please return <a href='$rel?admin'>click here</a>.</font>";} else { open (PRO,">$userdirectory/file.txt"); print PRO "$user1\n"; print PRO "$pass1"; close(PRO); print "<font color=\"$fontcolor\"><h2>new user info set.</h2></font>"; print "<font color=\"$fontcolor\">username = $user1.</font><br>"; print "<font color=\"$fontcolor\">password = $pass1.</font><br>"; print "<font color=\"$fontcolor\">please save for further use.</font>";} print "<p><table border=0 cellspacing=10><tbody><tr>\n"; print "<td><a href='$rel?newpost'>new article</a></td>\n"; print "<td><a href='$rel?delpost'>delete article</a></td>\n"; print "<td><a href='$rel?admin'>admin area</a></td>\n"; print "</tr></tbody></table>\n";} ###################################################################### # user login form. sub pwd { print "<font color=\"$fontcolor\"><h2>user login.</h2></font>"; print "<font color=\"$fontcolor\">please type in your password and username.</font>"; print "<form action=\"$rel?open\" method=\"post\">"; print "<table border=0 cellPadding=3><tbody>"; print "<tr><td><font color=\"$fontcolor\">username</font></td>"; print "<td><INPUT type=text name=user size=30></td></tr>"; print "<tr><td><font color=\"$fontcolor\">password</font></td>"; print "<td><INPUT type=text name=pass size=30></td></tr>"; print "</tbody></table>"; print "<INPUT name=submit type=submit value=submit> <INPUT name=reset type=reset value=reset></form>";} ###################################################################### # process user login form data. sub open { open (PRO,"$userdirectory/file.txt"); @user = <PRO>; close(PRO); $user = shift(@user); chomp($user); $pass = shift(@user); chomp($pass); if (("$user" eq "$user1") && ("$pass" eq "$pass1")) { print "<font color=\"$fontcolor\"><h2>welcome $user.</h2></font>"; print "<font color=\"$fontcolor\">where do you like to go?<br></font>"; print "<font color=\"$fontcolor\">please choose from following menue.</font>"; print "<table border=0 cellspacing=10><tbody><tr>\n"; print "<td><a href='$rel?newpost'>new article</a></td>\n"; print "<td><a href='$rel?delpost'>delete article</a></td>\n"; print "<td><a href='$rel?admin'>admin area</a></td>\n"; print "</tr></tbody></table>\n";} else { print "<font color=\"$fontcolor\"><h2>access denied.</h2></font>"; print "<font color=\"$fontcolor\">please try again <a href='$rel?pwd'>click here</a>.</font>";} } ###################################################################### # process environment variables. sub prolayout { if (("$slogan1" eq "") || ("$back1" eq "") || ("$font1" eq "") || ("$number1" eq "")) {print "<font color=\"$fontcolor\">alert fill in all fields. please return <a href='$rel?admin'>click here</a>.</font>";} else { open (ENV,">$userdirectory/layout.txt"); print ENV "$slogan1\n"; print ENV "$back1\n"; print ENV "$font1\n"; print ENV "$number1\n"; close (ENV); print "<font color=\"$fontcolor\"><h2>set layout variables.</h2></font>"; print "<font color=\"$fontcolor\">slogan = $slogan1.</font><br>"; print "<font color=\"$fontcolor\">background color = $back1.</font><br>"; print "<font color=\"$fontcolor\">font color = $font1.</font><br>"; print "<font color=\"$fontcolor\">number of articles = $number1.</font><br>";} print "<p><table border=0 cellspacing=10><tbody><tr>\n"; print "<td><a href='$rel?newpost'>new article</a></td>\n"; print "<td><a href='$rel?delpost'>delete article</a></td>\n"; print "<td><a href='$rel?admin'>admin area</a></td>\n"; print "</tr></tbody></table>\n";} ###################################################################### # get environment variables. sub layout { open (LAY,"$userdirectory/layout.txt"); @lay = <LAY>; close(LAY); $slogan = shift(@lay); chomp($slogan); $backcolor = shift(@lay); chomp($backcolor); $fontcolor = shift(@lay); chomp($fontcolor); $artnr = shift(@lay); chomp($artnr); $head = " <title>$slogan</title> <META content=\"all\" name=\"robots\"> <META content=\"follow\" name=\"robots\"> <META content=\"all\" name=\"audience\"> <META content=\"all\" name=\"rating\"> <META content=\"all\" name=\"Classification\"> <META content=\"Global\" name=\"distribution\"> <META content=\"30 days\" name=\"revisit-after\"> <META content=\"all\" name=\"voluntary content rating\"> <META content=\"$slogan, online journal, web diary, weblog\" name=\"page-type\"> <META content=\"$slogan, online journal, web diary, weblog\" name=\"description\"> <META content=\"$slogan,online journal,web diary,weblog,blogger,journal\" name=\"keywords\">"; # end of head. # leave like is or customize. $brick = "<font color=\"$fontcolor\">*</font>"; } ###################################################################### # search form. sub search { print "<font color=\"$fontcolor\"><h2>search $slogan.</h2></font>"; print "<font color=\"$fontcolor\">please type in your search request.</font>"; print "<form action=\"$rel?searchme\" method=\"post\">"; print "<table border=0 cellPadding=3><tbody>"; print "<tr><td><font color=\"$fontcolor\">search for</font></td>"; print "<td><INPUT type=text name=search size=40></td></tr>"; print "</tbody></table>"; print "<INPUT name=submit type=submit value=search> <INPUT name=reset type=reset value=reset></form>";} ###################################################################### # search process. sub searchme { if ("$search" eq "") {print "<font color=\"$fontcolor\">alert no data input. please return <a href='$rel?search'>click here</a>.</font>";} else { print "<font color=\"$fontcolor\"><h2>search results.</h2></font>"; chdir ("$textdirectory"); @searchun = glob "*.txt"; if (@searchun == "0") { print "<font color=\"$fontcolor\">soorry. no articles to search.";} else { print "<font color=\"$fontcolor\">following articles contain your search term: \"$search\".</font><p>"; @search = sort {$b <=> $a} @searchun; do { $se = shift(@search); $byte = -s "$textdirectory/$se"; open (SEARCH,"<$textdirectory/$se"); read (SEARCH, $data, $byte) or die "can not read $se: $!\n"; if ($data =~ /$search/i) { $found = "yes"; open (SEARCHA,"$textdirectory/$se"); @se = <SEARCHA>; $line = shift(@se); $popdate = pop(@se); print "<table border=1 cellpadding=5 width=600><tbody>"; print "<tr><td align=left><font color=\"$fontcolor\"><b>$line</b></font></td></tr>"; print "<tr><td align=left><font color=\"$fontcolor\">"; foreach $textline (@se) { print "$textline";} print "</font><p>"; print "<font color=\"$fontcolor\" size=\"-1\">$popdate</font></td></tr>"; print "</tbody></table><p>"; close(SEARCHA); } close(SEARCH); }until (@search == "0"); if ("$found" eq "") { print "<font color=\"$fontcolor\">ooops, no articles matched your search term: \"$search\".</font><p>";} }}} ###################################################################### ###################################################################### exit; # END